perm filename SWAP.WEB[MF,ALS] blob sn#764507 filedate 1984-08-06 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	@ The last and most difficult routine for transforming an edge structure---and
C00034 ENDMK
C⊗;
@ The last and most difficult routine for transforming an edge structure---and
the most interesting one!---is |xy_swap_edges|, which interchanges the
r\↑↑Doles of rows and columns. Its task can be viewed as the job of
creating an edge structure that contains only horizontal edges, linked
together in columns, given an edge structure that contains only
vertical edges linked together in rows; we must do this without changing
the implied pixel weights.

Given any two adjacent rows of an edge structure, it is not difficult to
determine the horizontal edges that lie ``between'' them: We simply look
for vertically adjacent pixels that have different weight, and insert
a horizontal edge containing the difference in weights. Every horizontal
edge determined in this way should be put into an appropriate linked
lists. Since random access to these linked lists is desirable, we use
the |move| array to hold the list heads. If we work through the given
edge structure from top to bottom, the constructed lists will not need
to be sorted, since they will already be in order.

The following algorithm makes use of some ideas suggested by John Hobby.
@↑Hobby, John Douglas@>
It assumes that the edge structure is non-null, i.e., that |link(cur_edges)
≠cur_edges| and |m_max(cur_edges)≥m_min(cur_edges)|.

@p procedure xy_swap_edges; {interchange |x| and |y| in |cur_edges|}
label done;
var @!m_magic,@!n_magic:integer; {special values that account for offsets}
@!p,@!q,@!r,@!s:pointer; {pointers that traverse the given structure}
@<Other local variables for |xy_swap_edges|@>@;
begin @<Initialize the array of new edge list heads@>;
@<Insert blank rows at the top and bottom, and set |p| to the new top row@>;
@<Compute the magic offset values@>;
repeat q←knil(p);@+if unsorted(q)>void then sort_edges(q);
@<Insert the horizontal edges defined by adjacent rows |p,q|,
	and destroy row~|p|@>;
p←q; n_magic←n_magic-8;
until knil(p)=cur_edges;
free_node(p,row_node_size); {now all original rows have been recycled}
@<Adjust the header to reflect the new edges@>;
end;

@ Here we don't bother to keep the |link| entries up to date, since the
procedure looks only at the |knil| fields as it destroys the former
edge structure.

@<Insert blank rows at the top and bottom...@>=
p←get_node(row_node_size); sorted(p)←sentinel; unsorted(p)←null;@/
knil(p)←cur_edges; knil(link(cur_edges))←p; {the new bottom row}
p←get_node(row_node_size); sorted(p)←sentinel;
knil(p)←knil(cur_edges); {the new top row}

@ The new lists will become |sorted| lists later, so we initialize
empty lists to |sentinel|.

@<Initialize the array of new edge list heads@>=
m_spread←m_max(cur_edges)-m_min(cur_edges); {this is |≥0| by assumption}
if m_spread>move_size then overflow("move table size",move_size);
@:METAFONT capacity exceeded move table size}{\quad move table size@>
for j←0 to m_spread do move[j]←sentinel

@ @<Other local variables for |xy_swap_edges|@>=
@!m_spread:integer; {the difference between |m_max| and |m_min|}
@!j,@!jj:0..move_size; {indices into |move|}
@!m,@!mm:integer; {|m| values at vertical edges}
@!pd,@!rd:integer; {data fields from edge-and-weight nodes}
@!pm,@!rm:integer; {|m| values from edge-and-weight nodes}
@!w:integer; {the difference in accumulated weight}
@!ww:integer; {as much of |w| that can be stored in a single node}
@!dw:integer; {an increment to be added to |w|}

@ At the point where we test |w≠0|, variable |w| contains
the accumulated weight from edges already passed in
row~|p| minus the accumulated weight from edges already passed in row~|q|.

@<Insert the horizontal edges defined by adjacent rows |p,q|...@>=
r←sorted(p); free_node(p,row_node_size); p←r;@/
pd←ho(info(p)); pm←pd div 8;@/
r←sorted(q); rd←ho(info(r)); rm←rd div 8; w←0;
loop@+	begin if pm<rm then mm←pm@+else mm←rm;
	if w≠0 then
		@<Insert horizontal edges of weight |w| between |m| and~|mm|@>;
	if pd<rd then
		begin dw←(pd mod 8)-zero_w;
		@<Advance pointer |p| to the next vertical edge,
			after destroying the previous one@>;
		end
	else	begin if r=sentinel then goto done; {|rd=pd=ho(max_halfword)|}
		dw←-((rd mod 8)-zero_w);
		@<Advance pointer |r| to the next vertical edge@>;
		end;
	m←mm; w←w+dw;
	end;
done:

@ @<Advance pointer |r| to the next vertical edge@>=
r←link(r); rd←ho(info(r)); rm←rd div 8

@ @<Advance pointer |p| to the next vertical edge...@>=
s←link(p); free_avail(p); p←s; pd←ho(info(p)); pm←pd div 8

@ Certain ``magic'' values are needed to make the following code work,
due to the various offsets in our data structure. For now, let's not
worry about their precise values; we shall compute |m_magic| and |n_magic|
later, after we see what the code looks like.

@ @<Insert horizontal edges of weight |w| between |m| and~|mm|@>=
if m≠mm then
	begin if mm-m_magic≥move_size then confusion("xy");
@:this can't happen xy}{\quad xy@>
	extras←(abs(w)-1) div 3;
	if extras>0 then
		begin if w>0 then xw←+3@+else xw←-3;
		ww←w-extras*xw;
		end
	else ww←w;
	repeat j←m-m_magic;
	for k←1 to extras do
		begin s←get_avail; info(s)←n_magic+xw;
		link(s)←move[j]; move[j]←s;
		end;
	s←get_avail; info(s)←n_magic+ww;
	link(s)←move[j]; move[j]←s;@/
	incr(m);
	until m=mm;
	end

@ @<Other local variables for |xy...@>=
@!extras:integer; {the number of additional nodes to make weights |>3|}
@!xw:-3..3; {the additional weight in extra nodes}
@!k:integer; {loop counter for inserting extra nodes}

@ At the beginning of this step, |move[m_spread]=sentinel|, because no
horizontal edges will extend to the right of column |m_max(cur_edges)|.

@<Adjust the header to reflect the new edges@>=
move[m_spread]←0; j←0;
while move[j]=sentinel do incr(j);
if j=m_spread then init_edges(cur_edges)
else	begin mm←m_min(cur_edges);
	m_min(cur_edges)←n_min(cur_edges);
	m_max(cur_edges)←n_max(cur_edges)+1;
	m_offset(cur_edges)←zero_field;
	jj←m_spread-1;
	while move[jj]=sentinel do decr(jj);
	n_min(cur_edges)←j+mm; n_max(cur_edges)←jj+mm; q←cur_edges;
	repeat p←get_node(row_node_size); link(q)←p; knil(p)←q;
	sorted(p)←move[j]; unsorted(p)←null; incr(j); q←p;
	until j>jj;
	link(q)←cur_edges; knil(cur_edges)←q;
	n_pos(cur_edges)←n_max(cur_edges)+1; n_rover(cur_edges)←cur_edges;
	last_window_time(cur_edges)←0;
	end;

@ The values of |m_magic| and |n_magic| can be worked out by trying the
code above on a small example; if they work correctly in simple cases,
they should work in general.

@<Compute the magic offset values@>=
m_magic←m_min(cur_edges)+m_offset(cur_edges)-zero_field;
n_magic←8*n_max(cur_edges)+8+zero_w-min_halfword

@ Now let's look at the subroutine that merges the edges from a given
edge structure into |cur_edges|. The given edge structure loses all its
edges.

@p procedure merge_edges(@!h:pointer);
label done;
var @!p,@!q,@!r,@!pp,@!qq,@!rr:pointer; {list manipulation registers}
@!n:integer; {row number}
@!k:halfword; {key register that we compare to |info(q)|}
@!delta:integer; {change to the edge/weight data}
begin if link(h)≠h then
	begin if (m_min(h)<m_min(cur_edges))∨(m_max(h)>m_max(cur_edges))∨@|
		(n_min(h)<n_min(cur_edges))∨(n_max(h)>n_max(cur_edges)) then
		edge_prep(m_min(h)-zero_field,m_max(h)-zero_field,
			n_min(h)-zero_field,n_max(h)-zero_field+1);
	if m_offset(h)≠m_offset(cur_edges) then
		@<Adjust the data of |h| to account for a difference of offsets@>;
	n←n_min(cur_edges); p←link(cur_edges); pp←link(h);
	while n<n_min(h) do
		begin incr(n); p←link(p);
		end;
	repeat @<Merge row |pp| into row |p|@>;
	pp←link(pp); p←link(p);
	until pp=h;
	end;
end;

@ @<Adjust the data of |h| to account for a difference of offsets@>=
begin pp←link(h); delta←8*(m_offset(cur_edges)-m_offset(h));
repeat qq←sorted(pp);
while qq>sentinel do
	begin info(qq)←info(qq)+delta; qq←link(qq);
	end;
qq←unsorted(pp);
while qq>void do
	begin info(qq)←info(qq)+delta; qq←link(qq);
	end;
pp←link(pp);
until pp=h;
end

@ The |sorted| and |unsorted| lists are merged separately. After this
step, row~|pp| will have no edges remaining, since they will all have
been merged into row~|p|.

@<Merge row |pp|...@>=
qq←unsorted(pp);
if qq>void then
	if unsorted(p)≤void then unsorted(p)←qq
	else	begin while link(qq)>void do qq←link(qq);
		link(qq)←unsorted(p); unsorted(p)←unsorted(pp);
		end;
unsorted(pp)←null; qq←sorted(pp);
if qq≠sentinel then
	begin if unsorted(p)=void then unsorted(p)←null;
	sorted(pp)←sentinel; r←sorted_loc(p); q←link(r); {|q=sorted(p)|}
	if q=sentinel then sorted(p)←qq
	else loop@+begin k←info(qq);
		while k>info(q) do
			begin r←q; q←link(r);
			end;
		link(r)←qq; rr←link(qq); link(qq)←q;
		if rr=sentinel then goto done;
		r←qq; qq←rr;
		end;
	end;
done:

@ \MF\ will display new edges as they are being computed, if |tracing_edges|
is positive. In order to keep such data reasonably compact, only the
points at which the path makes a $90↑\circ$ or $180↑\circ$ turn are listed.

The tracing algorithm must remember some past history in order to suppress
unnecessary data. Three variables |trace_x|, |trace_y|, and |trace_yy|
provide this history: The last coordinates printed were |(trace_x,trace_y)|,
and the previous edge traced ended at |(trace_x,trace_yy)|. Before anything
at all has been traced, |trace_x=-4096|.

@<Glob...@>=
@!trace_x:integer; {$x$-coordinate most recently shown in a trace}
@!trace_y:integer; {$y$-coordinate most recently shown in a trace}
@!trace_yy:integer; {$y$-coordinate most recently encountered}

@ Edge tracing is initiated by the |begin_edge_tracing| routine,
continued by the |trace_a_corner| routine, and terminated by the
|end_edge_tracing| routine.

@p procedure begin_edge_tracing;
begin print_diagnostic("Tracing edges","");
print(" (weight "); print_int(cur_wt); print_char(")"); trace_x←-4096;
end;
@#
procedure trace_a_corner;
begin if file_offset>max_print_line-13 then print_nl("");
print_char("("); print_int(trace_x); print_char(","); print_int(trace_yy);
print_char(")"); trace_y←trace_yy;
end;
@#
procedure end_edge_tracing;
begin if trace_x=-4096 then print_nl("(No new edges added.)")
@.No new edges added@>
else	begin trace_a_corner; print_char(".");
	end;
end_diagnostic(true);
end;

@ Just after a new edge weight has been put into the |info| field of
node~|r|, in row~|n|, the following routine continues an ongoing trace.

@p procedure trace_new_edge(@!r:pointer;@!n:integer);
var @!d:integer; {temporary data register}
@!w:-3..3; {weight associated with an edge transition}
@!m,@!n0,@!n1:integer; {column and row numbers}
begin d←ho(info(r)); w←(d mod 8)-zero_w; m←(d div 8)-m_offset(cur_edges);
if w=cur_wt then
	begin n0←n+1; n1←n;
	end
else	begin n0←n; n1←n+1;
	end; {the edges runs from |(m,n0)| to |(m,n1)|}
if m≠trace_x then
	begin if trace_x=-4096 then
		begin print_nl(""); trace_yy←n0;
		end
	else if trace_yy≠n0 then print_char("?") {shouldn't happen}
	else trace_a_corner;
	trace_x←m; trace_a_corner;
	end
else	begin if n0≠trace_yy then print_char("!"); {shouldn't happen}
	if ((n0<n1)∧(trace_y>trace_yy))∨((n0>n1)∧(trace_y<trace_yy)) then
		trace_a_corner;
	end;
trace_yy←n1;
end;

@ One way to put new edge weights into an edge structure is to use the
following routine, which simply draws a straight line from |(x0,y0)| to
|(x1,y1)|. More precisely, it introduces weights for the edges of the
discrete path $\bigl(\lfloor t[x_0,x_1]+{1\over2}+\epsilon\rfloor,
\lfloor t[y_0,y_1]+{1\over2}+\epsilon↑2\rfloor\bigr)$,
as $t$ varies from 0 to~1, where $\epsilon$ is an extremely small
positive number.

The structure header is assumed to be |cur_edges|; downward edge weights
will be |cur_wt|, while upward ones will be |-cur_wt|.

Of course, this subroutine will be called only in connection with others
that eventually draw a complete cycle, so that the sum of the edge weights
in each row will be zero whenever the row is displayed.

@p procedure line_edges(@!x0,@!y0,@!x1,@!y1:scaled);
label done,done1;
var @!m0,@!n0,@!m1,@!n1:integer; {rounded and unscaled coordinates}
@!delx,@!dely:scaled; {the coordinate differences of the line}
@!yt:scaled; {smallest |y| coordinate that rounds the same as |y0|}
@!tx:scaled; {tentative change in |x|}
@!p,@!r:pointer; {list manipulation registers}
@!base:integer; {amount added to edge-and-weight data}
@!n:integer; {current row number}
begin n0←round_unscaled(y0);
n1←round_unscaled(y1);
if n0≠n1 then
	begin m0←round_unscaled(x0); m1←round_unscaled(x1);
	delx←x1-x0; dely←y1-y0;
	yt←n0*unity-half_unit; y0←y0-yt; y1←y1-yt;
	if n0<n1 then @<Insert upward edges for a line@>
	else @<Insert downward edges for a line@>;
	n_rover(cur_edges)←p; n_pos(cur_edges)←n+zero_field;
	end;
end;

@ Here we are careful to cancel any effect of rounding error.

@<Insert upward edges for a line@>=
begin base←8*m_offset(cur_edges)+min_halfword+zero_w-cur_wt;
if m0≤m1 then edge_prep(m0,m1,n0,n1)@+else edge_prep(m1,m0,n0,n1);
@<Move to row |n0|, pointed to by |p|@>;
y0←unity-y0;
loop@+	begin r←get_avail; link(r)←unsorted(p); unsorted(p)←r;@/
	tx←take_fraction(delx,make_fraction(y0,dely));
	if ab_vs_cd(delx,y0,dely,tx)<0 then decr(tx);
		{now $|tx|=\lfloor|y0|\cdot|delx|/|dely|\rfloor$}
	info(r)←8*round_unscaled(x0+tx)+base;@/
	y1←y1-unity;
	if internal[tracing_edges]>0 then trace_new_edge(r,n);
	if y1<unity then goto done;
	p←link(p); y0←y0+unity; incr(n);
	end;
done: end

@ @<Insert downward edges for a line@>=
begin base←8*m_offset(cur_edges)+min_halfword+zero_w+cur_wt;
if m0≤m1 then edge_prep(m0,m1,n1,n0)@+else edge_prep(m1,m0,n1,n0);
decr(n0); @<Move to row |n0|, pointed to by |p|@>;
loop@+	begin r←get_avail; link(r)←unsorted(p); unsorted(p)←r;@/
	tx←take_fraction(delx,make_fraction(y0,dely));
	if ab_vs_cd(delx,y0,dely,tx)<0 then incr(tx);
		{now $|tx|=\lceil|y0|\cdot|delx|/|dely|\rceil$, since |dely<0|}
	info(r)←8*round_unscaled(x0-tx)+base;@/
	y1←y1+unity;
	if internal[tracing_edges]>0 then trace_new_edge(r,n);
	if y1≥0 then goto done1;
	p←knil(p); y0←y0+unity; decr(n);
	end;
done1: end

@ @<Move to row |n0|, pointed to by |p|@>=
n←n_pos(cur_edges)-zero_field; p←n_rover(cur_edges);
if n≠n0 then
	if n<n0 then
		repeat incr(n); p←link(p);
		until n=n0
	else	repeat decr(n); p←knil(p);
		until n=n0

@ \MF\ inserts most of its edges into edge structures via the
|move_to_edges| subroutine, which uses the data stored in the |move| array
to specify a sequence of ``rook moves.'' The starting point |(m0,n0)|
and finishing point |(m1,n1)| of these moves, as seen from the standpoint
of the first octant, are supplied as parameters; the moves should, however,
be rotated into a given octant, supplied as a further parameter.
(We're going to study octant transformations in great detail later; the
reader may wish to come back to this part of the program after mastering
the mysteries of octants.)

The rook moves themselves are defined as follows, from a |first_octant|
point of view: ``Go right |move[k]| steps, then go up one, for |0≤k<n1-n0|;
then go right |move[n1-n0]| steps and stop.'' The sum of |move[k]|
for |0≤k≤n1-n0| will be equal to |m1-m0|.

As in the |line_edges| routine, we use |+cur_wt| as the weight of
all downward edges and |-cur_wt| as the weight of all upward edges,
after the moves have been rotated to the proper octant direction.

There are two main cases to consider: \\{fast\_case} is for moves that
travel in the direction of octants 1, 4, 5, and~8, while \\{slow\_case}
is for moves that travel toward octants 2, 3, 6, and~7. The latter directions
are comparatively cumbersome because they generate more upward or downward
edges; a curve that travels horizontally doesn't produce any edges at all,
but a curve that travels vertically touches lots of rows.

@d fast_case_up=60 {for octants 1 and 4}
@d fast_case_down=61 {for octants 5 and 8}
@d slow_case_up=62 {for octants 2 and 3}
@d slow_case_down=63 {for octants 6 and 7}

@p procedure move_to_edges(@!m0,@!n0,@!m1,@!n1:integer;@!octant:small_number);
label fast_case_up,fast_case_down,slow_case_up,slow_case_down,done;
var @!delta:0..move_size; {extent of |move| data}
@!k:0..move_size; {index into |move|}
@!p,@!r:pointer; {list manipulation registers}
@!dx:integer; {change in edge-weight |info| when |x| changes by 1}
@!edge_and_weight:integer; {|info| to insert}
@!j:integer; {number of consecutive vertical moves}
@!n:integer; {the current row pointed to by |p|}
debug @!sum:integer;@+gubed@;@/
begin delta←n1-n0;
debug sum←move[0]; for k←1 to delta do sum←sum+abs(move[k]);
if sum≠m1-m0 then confusion("0");@+gubed@;@/
@<Prepare for and switch to the appropriate case, based on |octant|@>;
fast_case_up:@<Add edges for first or fourth octants, then |goto done|@>;
fast_case_down:@<Add edges for fifth or eighth octants, then |goto done|@>;
slow_case_up:@<Add edges for second or third octants, then |goto done|@>;
slow_case_down:@<Add edges for sixth or seventh octants, then |goto done|@>;
done: n_pos(cur_edges)←n+zero_field; n_rover(cur_edges)←p;
end;

@ @<Prepare for and switch to the appropriate case, based on |octant|@>=
case octant of
first_octant:begin dx←8; edge_prep(m0,m1,n0,n1); goto fast_case_up;
	end;
second_octant:begin dx←8; edge_prep(n0,n1,m0,m1); goto slow_case_up;
	end;
third_octant:begin dx←-8; edge_prep(-n1,-n0,m0,m1); negate(n0);
	goto slow_case_up;
	end;
fourth_octant:begin dx←-8; edge_prep(-m1,-m0,n0,n1); negate(m0);
	goto fast_case_up;
	end;
fifth_octant:begin dx←-8; edge_prep(-m1,-m0,-n1,-n0); negate(m0);
	goto fast_case_down;
	end;
sixth_octant:begin dx←-8; edge_prep(-n1,-n0,-m1,-m0); negate(n0);
	goto slow_case_down;
	end;
seventh_octant:begin dx←8; edge_prep(n0,n1,-m1,-m0); goto slow_case_down;
	end;
eighth_octant:begin dx←8; edge_prep(m0,m1,-n1,-n0); goto fast_case_down;
	end;
end; {there are only eight octants}

@ @<Add edges for first or fourth octants, then |goto done|@>=
@<Move to row |n0|, pointed to by |p|@>;
if delta>0 then
	begin k←0;
	edge_and_weight←8*(m0+m_offset(cur_edges))+min_halfword+zero_w-cur_wt;
	repeat edge_and_weight←edge_and_weight+dx*move[k];
	fast_get_avail(r); link(r)←unsorted(p); info(r)←edge_and_weight;
	if internal[tracing_edges]>0 then trace_new_edge(r,n);
	unsorted(p)←r; p←link(p); incr(k); incr(n);
	until k=delta;
	end;
goto done

@ @<Add edges for fifth or eighth octants, then |goto done|@>=
n0←-n0-1; @<Move to row |n0|, pointed to by |p|@>;
if delta>0 then
	begin k←0;
	edge_and_weight←8*(m0+m_offset(cur_edges))+min_halfword+zero_w+cur_wt;
	repeat edge_and_weight←edge_and_weight+dx*move[k];
	fast_get_avail(r); link(r)←unsorted(p); info(r)←edge_and_weight;
	if internal[tracing_edges]>0 then trace_new_edge(r,n);
	unsorted(p)←r; p←knil(p); incr(k); decr(n);
	until k=delta;
	end;
goto done

@ @<Add edges for second or third octants, then |goto done|@>=
edge_and_weight←8*(n0+m_offset(cur_edges))+min_halfword+zero_w-cur_wt;
n0←m0; k←0; @<Move to row |n0|, pointed to by |p|@>;
repeat j←move[k];
while j>0 do
	begin fast_get_avail(r); link(r)←unsorted(p); info(r)←edge_and_weight;
	if internal[tracing_edges]>0 then trace_new_edge(r,n);
	unsorted(p)←r; p←link(p); decr(j); incr(n);
	end;
edge_and_weight←edge_and_weight+dx; incr(k);
until k>delta;
goto done

@ @<Add edges for sixth or seventh octants, then |goto done|@>=
edge_and_weight←8*(n0+m_offset(cur_edges))+min_halfword+zero_w+cur_wt;
n0←-m0-1; k←0; @<Move to row |n0|, pointed to by |p|@>;
repeat j←move[k];
while j>0 do
	begin fast_get_avail(r); link(r)←unsorted(p); info(r)←edge_and_weight;
	if internal[tracing_edges]>0 then trace_new_edge(r,n);
	unsorted(p)←r; p←knil(p); decr(j); decr(n);
	end;
edge_and_weight←edge_and_weight+dx; incr(k);
until k>delta;
goto done

@ All the hard work of building an edge structure is undone by the following
subroutine.

@<Declare the recycling subroutines@>=
procedure toss_edges(@!h:pointer);
var @!p,@!q:pointer; {for list manipulation}
begin q←link(h);
while q≠h do
	begin flush_list(sorted(q));
	if unsorted(q)>void then flush_list(unsorted(q));
	p←q; q←link(q); free_node(p,row_node_size);
	end;
free_node(h,edge_header_size);
end;